home *** CD-ROM | disk | FTP | other *** search
/ Software 2000 / Software 2000 Volume 1 (Disc 1 of 2).iso / utilities / u303.dms / in.adf / Sprite_Grabber.AMOS / Sprite_Grabber.amosSourceCode < prev   
Encoding:
AMOS Source Code  |  1990-11-07  |  3.9 KB  |  220 lines
  1. '----------------------------  
  2. '-    Bob Grabber Utility   -  
  3. '-    by Aaron Fothergill   -
  4. '- (c) Mandarin / Jawx 1990 -
  5. '----------------------------
  6. Y=0
  7. YO=-1
  8. SCH=200
  9. SCW=320
  10. Unpack 6 To 1
  11. Gosub GTSCRN
  12. SX=0 : SY=0 : SXO=-1 : XO=-1
  13. Screen To Front 1
  14. STZONES
  15. SNUM=1
  16. SHWSNUM[SNUM]
  17. Do 
  18.    K=Mouse Key : Z=Mouse Zone
  19.    If K=0 Then TICK=0
  20.    X=X Screen(X Mouse)
  21.    If X/160<>XO
  22.       XO=X/160
  23.       SHWSPRT[Y,SNUM,X]
  24.    End If 
  25.    If K>0 and Z>0
  26.       On Z Gosub DWN,UP,CUT,GTSCRN,GTSPR,SVSPR,QUIT
  27.       SHWSPRT[Y,SNUM,X]
  28.    End If 
  29.    If Y<>YO
  30.       YO=Y
  31.       DISPBAR[Y]
  32.       SHWSPRT[Y,SNUM,X]
  33.    End If 
  34.    If SY<>SYO or SX<>SXO
  35.       DISPSCRN[SX,SY]
  36.       SXO=SX : SYO=SY
  37.    End If 
  38.    A$=Inkey$
  39.    If A$=Chr$(30)
  40.       If Y>0
  41.          Add Y,-4
  42.       Else 
  43.          If SY>0
  44.             Add SY,-4
  45.          End If 
  46.       End If 
  47.    End If 
  48.    If A$=Chr$(31)
  49.       If Y<SCH-24
  50.          Add Y,4
  51.       Else 
  52.          If SY<Max(0,SCY-SCH)
  53.             Add SY,4
  54.          End If 
  55.       End If 
  56.    End If 
  57.    If A$=Chr$(28)
  58.       If SX>0
  59.          Add SX,-16
  60.       End If 
  61.    End If 
  62.    If A$=Chr$(29)
  63.       If SX<Max(0,SCX-SCW*REZ)
  64.          Add SX,16
  65.       End If 
  66.    End If 
  67. Loop 
  68. QUIT:
  69. End 
  70. Return 
  71. GTSPR:
  72. SNUM=1
  73. F$=""
  74. F$=Fsel$("*.ABK","","Load a Sprite Bank")
  75. If F$<>""
  76.    F2$=Right$(F$,4)
  77.    If Upper$(F2$)=".ABK"
  78.       Erase 1
  79.       Load F$
  80.       A$="" : A=0 : Repeat : A$=A$+Chr$(Peek(Start(1)-8+A)) : Inc A : Until A=8
  81.       If A$<>"Sprites "
  82.          F$=""
  83.       Else 
  84.          Screen 0
  85.          Get Sprite Palette 
  86.          Screen 1
  87.       End If 
  88.    Else 
  89.       F$=""
  90.    End If 
  91. End If 
  92. Return 
  93. SVSPR:
  94. F$=Fsel$("","","Save the Sprite Bank As:")
  95. If F$<>""
  96.    F2$=Right$(F$,4)
  97.    If Upper$(F2$)=".ABK"
  98.       Save F$,1
  99.    End If 
  100. End If 
  101. Return 
  102. CUT:
  103. If Fast Free+Chip Free>10000
  104. Bob 1,999,1,1
  105. Update 
  106. Update Off 
  107. Screen To Front 0
  108. Screen 0
  109. Get Block 1,0,0,SCX,SCY
  110. X2O=-1 : Y2O=-1
  111. While Mouse Key<>0 : Wend : Wait 5
  112. While Mouse Key=0 : Wend : X1=X Screen(X Mouse) : Y1=Y Screen(Y Mouse)
  113. While Mouse Key>0 : X2=X Screen(X Mouse) : Y2=Y Screen(Y Mouse)
  114.    If X2O<>X2 or Y2O<>Y2
  115.  Gosub SHWBOX : X2O=X2 : Y2O=Y2
  116. End If 
  117. Wend 
  118. Gosub SHWBOX : Put Block 1,0,0
  119. Get Bob SNUM,Max(0,X1),Max(0,Y1) To Max(0,X2),Max(0,Y2)
  120. Update On 
  121. Screen To Front 1 : Screen 1
  122. Bob Off 1
  123. Update 
  124. Del Block 1
  125. End If 
  126. Return 
  127. SHWBOX:
  128. Put Block 1,0,0
  129. Ink 1
  130. X3=Min(X1,X2) : X2=Max(X1,X2) : X1=X3
  131. Y3=Min(Y1,Y2) : Y2=Max(Y1,Y2) : Y1=Y3
  132. X2=Max(X1+1,X2) : Y2=Max(Y1+1,Y2)
  133. Gr Writing 3
  134. Box X1,Y1 To X2,Y2
  135. Gr Writing 1
  136. Return 
  137. DWN:
  138. If SNUM>1
  139.    Dec SNUM
  140.    SHWSNUM[SNUM]
  141.    While Mouse Key<>0 and TICK<1000
  142.       Inc TICK
  143.    Wend : TICK=Min(TICK,500)
  144. End If 
  145. Return 
  146. UP:
  147. If SNUM<Length(1)+1
  148.    Inc SNUM
  149.    SHWSNUM[SNUM]
  150.    While Mouse Key<>0 and TICK<1000
  151.       Inc TICK
  152.    Wend : TICK=Min(TICK,500)
  153. End If 
  154. Return 
  155. GTSCRN:
  156. F$=Fsel$("","","Pick a Picture !")
  157. If F$<>""
  158.    Auto View Off 
  159.    Screen Close 0
  160. If Upper$(Right$(F$,4))=".ABK"
  161. Load F$,5
  162. Unpack 5 To 0
  163. Erase 5
  164. Else 
  165.    Load Iff F$,0
  166. End If 
  167.    A=Screen Base+72
  168.    SCX=Deek(A+4)
  169.    SCY=Deek(A+6)
  170.    REZ=1
  171.    If Btst(Deek(A),15)
  172.       REZ=2
  173.    End If 
  174.    Screen To Front 1
  175.    Auto View On 
  176. End If 
  177. Return 
  178. Procedure DISPBAR[YPOS]
  179.    Screen Display 1,,48+YPOS,,24
  180. End Proc
  181. Procedure DISPSCRN[XPOS,YPOS]
  182.    Shared SCX,SCY
  183.    Screen Display 0,,48-YPOS,,SCY
  184.    Screen Offset 0,XPOS,0
  185. End Proc
  186. Procedure SHWSNUM[S]
  187.    S$=Mid$(Str$(S),2)
  188.    S$=Right$("00"+S$,3)
  189.    Ink 1,6
  190.    Text 68,18,S$
  191. End Proc
  192. Procedure STZONES
  193.    Screen 1
  194.    Reserve Zone 8
  195.    Set Zone 1,48,8 To 64,24
  196.    Set Zone 2,96,8 To 112,24
  197.    Set Zone 3,112,8 To 144,24
  198.    Set Zone 4,144,8 To 176,24
  199.    Set Zone 5,176,8 To 208,24
  200.    Set Zone 6,208,8 To 240,24
  201.    Set Zone 7,288,8 To 320,24
  202. End Proc
  203. Procedure SHWSPRT[YPOS,N,MX]
  204.    Screen 0
  205.    If Length(1)>=N
  206.       BX=80 : If MX<160
  207.          BX=240
  208.       End If 
  209.       BY=YPOS+30+Deek(Sprite Base(N)+8)
  210.       If YPOS>100
  211.          BY=BY-34-Deek(Sprite Base(N)+2)
  212.       End If 
  213.          Bob 1,BX,BY,N
  214.       Update 
  215. Else 
  216. Bob Off 1
  217. Update 
  218.    End If 
  219.    Screen 1
  220. End Proc